home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / finput.zip / FINPUT.PAS next >
Pascal/Delphi Source File  |  1991-01-01  |  13KB  |  423 lines
  1. unit FInput;
  2. {$X+}
  3. {
  4.   This unit implements a derivative of TInputLine that supports several
  5.   data types dynamically.  It also provides formatted input for all the
  6.   numerical types, keystroke filtering and uppercase conversion, field
  7.   justification, and range checking.
  8.  
  9.   When the field is initialized, many filtering and uppercase converions
  10.   are implemented pertinent to the particular data type.
  11.  
  12.   The CheckRange and ErrorHandler methods should be overridden if the
  13.   user wants to implement then.
  14.  
  15.   This is just an initial implementation and comments are welcome. You
  16.   can contact me via Compuserve. (76066,3202)
  17.  
  18.   I am releasing this into the public domain and anyone can use or modify
  19.   it for their own personal use.
  20.  
  21.   Copyright (c) 1990 by Allen Bauer (76066,3202)
  22.  
  23.   This is version 1.1 - fixed input validation functions
  24.  
  25. }
  26.  
  27. interface
  28. uses Objects, Drivers, Dialogs;
  29.  
  30. type
  31.   VKeys = set of char;
  32.  
  33.   PFInputLine = ^TFInputLine;
  34.   TFInputLine = object(TInputLine)
  35.     ValidKeys : VKeys;
  36.     DataType,Decimals : byte;
  37.     imMode : word;
  38.     Validated, ValidSent : boolean;
  39.     constructor Init(var Bounds: TRect; AMaxLen: integer;
  40.                      ChrSet: VKeys;DType, Dec: byte);
  41.     constructor Load(var S: TStream);
  42.     procedure Store(var S: TStream);
  43.     procedure HandleEvent(var Event: TEvent); virtual;
  44.     procedure GetData(var Rec); virtual;
  45.     procedure SetData(var Rec); virtual;
  46.     function DataSize: word; virtual;
  47.     procedure Draw; virtual;
  48.     function CheckRange: boolean; virtual;
  49.     procedure ErrorHandler; virtual;
  50.   end;
  51.  
  52. const
  53.   imLeftJustify   = $0001;
  54.   imRightJustify  = $0002;
  55.   imConvertUpper  = $0004;
  56.  
  57.   DString   = 0;
  58.   DChar     = 1;
  59.   DReal     = 2;
  60.   DByte     = 3;
  61.   DShortInt = 4;
  62.   DInteger  = 5;
  63.   DLongInt  = 6;
  64.   DWord     = 7;
  65.   DDate     = 8;
  66.   DTime     = 9;
  67.  
  68.   DRealSet      : VKeys = [#1..#31,'+','-','0'..'9','.','E','e'];
  69.   DSignedSet    : VKeys = [#1..#31,'+','-','0'..'9'];
  70.   DUnSignedSet  : VKeys = [#1..#31,'0'..'9'];
  71.   DCharSet      : VKeys = [#1..#31,' '..'~'];
  72.   DUpperSet     : VKeys = [#1..#31,' '..'`','{'..'~'];
  73.   DAlphaSet     : VKeys = [#1..#31,'A'..'Z','a'..'z'];
  74.   DFileNameSet  : VKeys = [#1..#31,'!','#'..')','-'..'.','0'..'9','@'..'Z','^'..'{','}'..'~'];
  75.   DPathSet      : VKeys = [#1..#31,'!','#'..')','-'..'.','0'..':','@'..'Z','^'..'{','}'..'~','\'];
  76.   DFileMaskSet  : VKeys = [#1..#31,'!','#'..'*','-'..'.','0'..':','?'..'Z','^'..'{','}'..'~','\'];
  77.   DDateSet      : VKeys = [#1..#31,'0'..'9','/'];
  78.   DTimeSet      : VKeys = [#1..#31,'0'..'9',':'];
  79.  
  80.   cmValidateYourself = 2000;
  81.  
  82. procedure RegisterFInputLine;
  83.  
  84. const
  85.   RFInputLine : TStreamRec = (
  86.     ObjType: 20000;
  87.     VmtLink: Ofs(typeof(TFInputLine)^);
  88.     Load:    @TFInputLine.Load;
  89.     Store:   @TFinputLine.Store
  90.   );
  91.  
  92. implementation
  93.  
  94. uses Views, MsgBox, StrFmt, Dos;
  95.  
  96. function CurrentDate : string;
  97. var
  98.   Year,Month,Day,DOW : word;
  99.   DateStr : string[10];
  100. begin
  101.   GetDate(Year,Month,Day,DOW);
  102.   DateStr := SFLongint(Month,2)+'/'
  103.             +SFLongInt(Day,2)+'/'
  104.             +SFLongInt(Year mod 100,2);
  105.   for DOW := 1 to length(DateStr) do
  106.     if DateStr[DOW] = ' ' then
  107.       DateStr[DOW] := '0';
  108.   CurrentDate := DateStr;
  109. end;
  110.  
  111. function CurrentTime : string;
  112. var
  113.   Hour,Minute,Second,Sec100 : word;
  114.   TimeStr : string[10];
  115. begin
  116.   GetTime(Hour,Minute,Second,Sec100);
  117.   TimeStr := SFLongInt(Hour,2)+':'
  118.             +SFLongInt(Minute,2)+':'
  119.             +SFLongInt(Second,2);
  120.   for Sec100 := 1 to length(TimeStr) do
  121.     if TimeStr[Sec100] = ' ' then
  122.       TimeStr[Sec100] := '0';
  123.   CurrentTime := TimeStr;
  124. end;
  125.  
  126. procedure RegisterFInputLine;
  127. begin
  128.   RegisterType(RFInputLine);
  129. end;
  130.  
  131. constructor TFInputLine.Init(var Bounds: TRect; AMaxLen: integer;
  132.                              ChrSet: VKeys; DType, Dec: byte);
  133. begin
  134.   if (DType in [DDate,DTime]) and (AMaxLen < 8) then
  135.     AMaxLen := 8;
  136.  
  137.   TInputLine.Init(Bounds,AMaxLen);
  138.  
  139.   ValidKeys:= ChrSet;
  140.   DataType := DType;
  141.   Decimals := Dec;
  142.   Validated := true;
  143.   ValidSent := false;
  144.   case DataType of
  145.     DReal,DByte,DLongInt,
  146.     DShortInt,DWord      : imMode := imRightJustify;
  147.  
  148.     DChar,DString,
  149.     DDate,DTime          : imMode := imLeftJustify;
  150.   end;
  151.   if ValidKeys = DUpperSet then
  152.     imMode := imMode or imConvertUpper;
  153.   EventMask := EventMask or evMessage;
  154. end;
  155.  
  156. constructor TFInputLine.Load(var S: TStream);
  157. begin
  158.   TInputLine.Load(S);
  159.   S.Read(ValidKeys, sizeof(VKeys));
  160.   S.Read(DataType,  sizeof(byte));
  161.   S.Read(Decimals,  sizeof(byte));
  162.   S.Read(imMode,    sizeof(word));
  163.   S.Read(Validated, sizeof(boolean));
  164.   S.Read(ValidSent, sizeof(boolean));
  165. end;
  166.  
  167. procedure TFInputLine.Store(var S: TStream);
  168. begin
  169.   TInputLine.Store(S);
  170.   S.Write(ValidKeys, sizeof(VKeys));
  171.   S.Write(DataType,  sizeof(byte));
  172.   S.Write(Decimals,  sizeof(byte));
  173.   S.Write(imMode,    sizeof(word));
  174.   S.Write(Validated, sizeof(boolean));
  175.   S.Write(ValidSent, sizeof(boolean));
  176. end;
  177.  
  178. procedure TFInputLine.HandleEvent(var Event: TEvent);
  179. var
  180.   NewEvent: TEvent;
  181. begin
  182.   case Event.What of
  183.     evKeyDown :  begin
  184.                    if (imMode and imConvertUpper) <> 0 then
  185.                      Event.CharCode := upcase(Event.CharCode);
  186.                    if not(Event.CharCode in [#0..#31]) then
  187.                    begin
  188.                      Validated := false;
  189.                      ValidSent := false;
  190.                    end;
  191.                    if (Event.CharCode <> #0) and not(Event.CharCode in ValidKeys) then
  192.                      ClearEvent(Event);
  193.                  end;
  194.     evBroadcast: begin
  195.                    if (Event.Command = cmReceivedFocus) and
  196.                       (Event.InfoPtr <> @Self) and
  197.                      ((Owner^.State and sfSelected) <> 0) and
  198.                         not(Validated) and not(ValidSent) then
  199.                    begin
  200.                      NewEvent.What := evBroadcast;
  201.                      NewEvent.InfoPtr := @Self;
  202.                      NewEvent.Command := cmValidateYourself;
  203.                      PutEvent(NewEvent);
  204.                      ValidSent := true;
  205.                    end;
  206.                    if (Event.Command = cmValidateYourself) and
  207.                       (Event.InfoPtr = @Self) then
  208.                    begin
  209.                      if not CheckRange then
  210.                      begin
  211.                        ErrorHandler;
  212.                        Select;
  213.                      end
  214.                      else
  215.                        Validated := true;
  216.                      ValidSent := false;
  217.                      ClearEvent(Event);
  218.                    end;
  219.                  end;
  220.   end;
  221.   TInputLine.HandleEvent(Event);
  222. end;
  223.  
  224. procedure TFInputLine.GetData(var Rec);
  225. var
  226.   Code : integer;
  227. begin
  228.   case DataType of
  229.     Dstring,
  230.     DDate,
  231.     DTime     : TInputLine.GetData(Rec);
  232.     DChar     : char(Rec) := Data^[1];
  233.     DReal     : val(Data^, real(Rec)     , Code);
  234.     DByte     : val(Data^, byte(Rec)     , Code);
  235.     DShortInt : val(Data^, shortint(Rec) , Code);
  236.     DInteger  : val(Data^, integer(Rec)  , Code);
  237.     DLongInt  : val(Data^, longint(Rec)  , Code);
  238.     DWord     : val(Data^, word(Rec)     , Code);
  239.   end;
  240. end;
  241.  
  242. procedure TFInputLine.SetData(var Rec);
  243. begin
  244.   case DataType of
  245.     DString,
  246.     DDate,
  247.     DTime     : TInputLine.SetData(Rec);
  248.     DChar     : Data^ := char(Rec);
  249.     DReal     : Data^ := SFDReal(real(Rec),MaxLen,Decimals);
  250.     DByte     : Data^ := SFLongInt(byte(Rec),MaxLen);
  251.     DShortInt : Data^ := SFLongInt(shortint(Rec),MaxLen);
  252.     DInteger  : Data^ := SFLongInt(integer(Rec),MaxLen);
  253.     DLongInt  : Data^ := SFLongInt(longint(Rec),MaxLen);
  254.     DWord     : Data^ := SFLongInt(word(Rec),MaxLen);
  255.   end;
  256.   SelectAll(true);
  257. end;
  258.  
  259. function TFInputLine.DataSize: word;
  260. begin
  261.   case DataType of
  262.     DString,
  263.     DDate,
  264.     DTime     : DataSize := TInputLine.DataSize;
  265.     DChar     : DataSize := sizeof(char);
  266.     DByte     : DataSize := sizeof(byte);
  267.     DShortInt : DataSize := sizeof(shortint);
  268.     DInteger  : DataSize := sizeof(integer);
  269.     DLong